home *** CD-ROM | disk | FTP | other *** search
/ BMUG Revelations / BMUG Revelations.toast / Programming / Programming Languages / Yerk 3.64 / Supplement / my stuff / zoomrect < prev   
Text File  |  1990-12-31  |  2KB  |  78 lines
  1. \ 02-16-88 srp class of rects that zoom
  2. \                          used especially for windows opening and closing
  3. \                          (as in the finder)
  4. \                          use a grafport defined for the entire screen
  5. \                          so that zooming rects are not clipped to
  6. \                          the current grafport
  7. \
  8. : zoom ;
  9.  
  10. 0 variable penstate 14 allot
  11.  
  12. : savepstate penstate +base call GetPenState ;
  13. : restPstate penstate +base call SetPenState ;
  14.  
  15. : l->g pack thepoint ! thepoint +base
  16.         call localtoglobal thepoint @ unpack ;
  17.  
  18. :Class BigPort <Super GrafPort
  19.  
  20. :M New: (abs) call OpenPort ;M
  21.  
  22. :M Close: (abs) call ClosePort ;M
  23.  
  24. :M Clip: addr: self 28 + @ -base @ -base 2+ put: rect ;M
  25.  
  26. ;Class
  27.  
  28. BigPort Screen
  29.  
  30. :Class ZoomRect <Super Rect
  31.  
  32.         int #steps
  33.         int Ldiff
  34.         int Tdiff
  35.         int Rdiff
  36.         int Bdiff
  37.         int swidth
  38.         int shght
  39.         rect source
  40.         rect dest
  41.  
  42. :M Diffs: gettopx: dest gettopx: source - put: Ldiff
  43.         gettopy: dest gettopy: source - put: Tdiff
  44.         size: source put: shght put: swidth
  45.         size: dest get: shght - put: Bdiff get: swidth - put: Rdiff ;M
  46.  
  47. :M Init: put: source put: dest put: #steps Diffs: self ;M
  48.  
  49. :M Steps: put: #steps ;M
  50.  
  51. :M Zoom: { \ zsteps ind zleft ztop -- }
  52.         savepstate
  53.         3 syspat +base call penpat
  54.         14 makeint call penmode
  55.         get: #steps -> zsteps
  56.         2 0
  57.         DO zsteps 0
  58.            DO i 1+ -> ind
  59.                   gettopx: source get: Ldiff ind * zsteps / + -> zleft
  60.                   gettopy: source get: Tdiff ind * zsteps / + -> ztop
  61.                   zleft ztop
  62.                   zleft get: swidth + get: Rdiff ind * zsteps / +
  63.                   ztop get: shght + get: Bdiff ind * zsteps / +
  64.                   put: self draw: self
  65.            LOOP
  66.         LOOP
  67.         restpstate ;M
  68.  
  69. ;Class
  70.  
  71. zoomrect Zoomer
  72.  
  73. 20 100 100 200 200 getrect: fwind init: zoomer
  74.  
  75. : ZoomIt pushport new: screen set: screen zoom: zoomer close: screen popport ;
  76.  
  77.  
  78.